home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / POINTERS.SWG / 0011_AVL Binary Trees.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  7KB  |  333 lines
  1. {
  2. > Does anyone have code(preferably TP) the implements AVL trees?
  3. > I'm having trouble With the insertion part of it.  I'm writing a small
  4. > parts inventory Program For work(although I'm not employed as a
  5. > Programmer) and the AVL tree would be very fast For it.
  6. }
  7.  
  8.  
  9. Program avl;
  10.  
  11. Type
  12.   nodeptr = ^node;
  13.   node    = Record
  14.     key   : Char;
  15.     bal   : -1..+1; { bal = h(right) - h(left) }
  16.     left,
  17.     right : nodeptr
  18.   end;
  19.  
  20.   tree = nodeptr;
  21.  
  22. Var
  23.   t : tree;
  24.   h : Boolean; { insert & delete parameter }
  25.  
  26.  
  27. Procedure maketree(Var t : tree);
  28. begin
  29.   t := nil;
  30. end;
  31.  
  32. Function member(k : Char; t : tree) : Boolean;
  33. begin { member }
  34.   if t = nil then
  35.     member := False
  36.   else
  37.   if k = t^.key then
  38.     member := True
  39.   else
  40.   if k < t^.key then
  41.     member := member(k, t^.left)
  42.   else
  43.     member := member(k, t^.right);
  44. end;
  45.  
  46. Procedure ll(Var t : tree);
  47. Var
  48.   p : tree;
  49. begin
  50.   p := t^.left;
  51.   t^.left  := p^.right;
  52.   p^.right := t;
  53.   t := p;
  54. end;
  55.  
  56. Procedure rr(Var t : tree);
  57. Var
  58.    p : tree;
  59. begin
  60.   p := t^.right;
  61.   t^.right := p^.left;
  62.   p^.left  := t;
  63.   t := p;
  64. end
  65.  
  66. Procedure lr(Var t : tree);
  67. begin
  68.   rr(t^.left);
  69.   ll(t);
  70. end;
  71.  
  72. Procedure rl(Var t : tree);
  73. begin
  74.   ll(t^.right);
  75.   rr(t);
  76. end;
  77.  
  78. Procedure insert(k : Char; Var t : tree; Var h : Boolean);
  79.  
  80.   Procedure balanceleft(Var t : tree; Var h : Boolean);
  81.   begin
  82.     Writeln('balance left');
  83.     Case t^.bal of
  84.       +1 :
  85.         begin
  86.           t^.bal := 0;
  87.           h := False;
  88.         end;
  89.        0 : t^.bal := -1;
  90.       -1 :
  91.         begin { rebalance }
  92.           if t^.left^.bal = -1 then
  93.           begin { single ll rotation }
  94.             Writeln('single ll rotation');
  95.             ll(t);
  96.             t^.right^.bal := 0;
  97.           end
  98.           else { t^.left^.bal  = +1 }
  99.           begin  { double lr rotation }
  100.             Writeln('double lr rotation');
  101.             lr(t);
  102.             if t^.bal = -1 then
  103.               t^.right^.bal := +1
  104.             else
  105.               t^.right^.bal := 0;
  106.             if t^.bal = +1 then
  107.               t^.left^.bal := -1
  108.             else
  109.               t^.left^.bal := 0;
  110.           end;
  111.           t^.bal := 0;
  112.           h := False;
  113.         end;
  114.     end;
  115.   end;
  116.  
  117.   Procedure balanceright(Var t : tree; Var h : Boolean);
  118.   begin
  119.     Writeln('balance right');
  120.     Case t^.bal of
  121.       -1 :
  122.         begin
  123.           t^.bal := 0;
  124.           h := False;
  125.         end;
  126.        0 : t^.bal := +1;
  127.       +1 :
  128.         begin { rebalance }
  129.           if t^.right^.bal = +1 then
  130.           begin { single rr rotation }
  131.             Writeln('single rr rotation');
  132.             rr(t);
  133.             t^.left^.bal := 0
  134.           end
  135.           else { t^.right^.bal  = -1 }
  136.           begin  { double rl rotation }
  137.             Writeln('double rl rotation');
  138.             rl(t);
  139.             if t^.bal = -1 then
  140.               t^.right^.bal := +1
  141.             else
  142.               t^.right^.bal := 0;
  143.             if t^.bal = +1 then
  144.               t^.left^.bal := -1
  145.             else
  146.               t^.left^.bal := 0;
  147.           end;
  148.           t^.bal := 0;
  149.           h := False;
  150.         end;
  151.     end;
  152.   end;
  153.  
  154. begin { insert }
  155.   if t = nil then
  156.   begin
  157.     new(t);
  158.     t^.key   := k;
  159.     t^.bal   := 0;
  160.     t^.left  := nil;
  161.     t^.right := nil;
  162.           h := True;
  163.   end
  164.   else
  165.   if k < t^.key then
  166.   begin
  167.     insert(k, t^.left, h);
  168.           if h then
  169.       balanceleft(t, h);
  170.   end
  171.   else
  172.   if k > t^.key then
  173.   begin
  174.     insert(k, t^.right, h);
  175.     if h then
  176.       balanceright(t, h);
  177.   end;
  178. end;
  179.  
  180. Procedure delete(k : Char; Var t : tree; Var h : Boolean);
  181.  
  182.   Procedure balanceleft(Var t : tree; Var h : Boolean);
  183.   begin
  184.     Writeln('balance left');
  185.     Case t^.bal of
  186.       -1 :
  187.         begin
  188.           t^.bal := 0;
  189.           h := True;
  190.         end;
  191.        0 :
  192.          begin
  193.                  t^.bal := +1;
  194.                  h := False;
  195.                end;
  196.       +1 :
  197.         begin { rebalance }
  198.           if t^.right^.bal >= 0 then
  199.           begin
  200.             Writeln('single rr rotation'); { single rr rotation }
  201.                         if t^.right^.bal = 0 then
  202.             begin
  203.               rr(t);
  204.                           t^.bal := -1;
  205.                           h := False;
  206.                         end
  207.                         else
  208.             begin
  209.               rr(t);
  210.                           t^.left^.bal := 0;
  211.                           t^.bal := 0;
  212.                           h := True;
  213.                         end;
  214.           end
  215.           else { t^.right^.bal  = -1 }
  216.           begin
  217.                         Writeln('double rl rotation');
  218.                    rl(t);
  219.                         t^.left^.bal := 0;
  220.             t^.right^.bal := 0;
  221.                         h := True;
  222.                       end;
  223.         end;
  224.     end;
  225.   end;
  226.  
  227.   Procedure balanceright(Var t : tree; Var h : Boolean);
  228.   begin
  229.     Writeln('balance right');
  230.     Case t^.bal of
  231.       +1 :
  232.         begin
  233.           t^.bal := 0;
  234.           h := True;
  235.         end;
  236.        0 :
  237.          begin
  238.                  t^.bal := -1;
  239.                  h := False;
  240.                end;
  241.       -1 :
  242.         begin { rebalance }
  243.           if t^.left^.bal <= 0 then
  244.           begin { single ll rotation }
  245.             Writeln('single ll rotation');
  246.                         if t^.left^.bal = 0 then
  247.             begin
  248.               ll(t);
  249.                           t^.bal := +1;
  250.                           h := False;
  251.                         end
  252.                         else
  253.             begin
  254.               ll(t);
  255.                           t^.left^.bal := 0;
  256.                           t^.bal := 0;
  257.                           h := True;
  258.                         end;
  259.           end
  260.           else { t^.left^.bal  = +1 }
  261.           begin  { double lr rotation }
  262.             Writeln('double lr rotation');
  263.             lr(t);
  264.                         t^.left^.bal := 0;
  265.                         t^.right^.bal := 0;
  266.                         h := True;
  267.           end;
  268.         end;
  269.     end;
  270.   end;
  271.  
  272.   Function deletemin(Var t : tree; Var h : Boolean) : Char;
  273.   begin { deletemin }
  274.     if t^.left = nil then
  275.     begin
  276.       deletemin := t^.key;
  277.       t := t^.right;
  278.             h := True;
  279.     end
  280.     else
  281.     begin
  282.       deletemin := deletemin(t^.left, h);
  283.             if h then
  284.         balanceleft(t, h);
  285.     end;
  286.   end;
  287.  
  288. begin { delete }
  289.   if t <> nil then
  290.   begin
  291.     if k < t^.key then
  292.     begin
  293.       delete(k, t^.left, h);
  294.             if h then
  295.         balanceleft(t, h);
  296.     end
  297.     else
  298.     if k > t^.key then
  299.     begin
  300.       delete(k, t^.right, h);
  301.             if h then
  302.         balanceright(t, h);
  303.     end
  304.     else
  305.     if (t^.left = nil) and (t^.right = nil) then
  306.     begin
  307.       t := nil;
  308.             h := True;
  309.     end
  310.     else
  311.     if t^.left = nil then
  312.     begin
  313.       t := t^.right;
  314.             h := True;
  315.     end
  316.     else
  317.     if t^.right = nil then
  318.     begin
  319.       t := t^.left;
  320.             h := True;
  321.     end
  322.     else
  323.     begin
  324.       t^.key := deletemin(t^.right, h);
  325.             if h then
  326.               balanceright(t, h);
  327.     end;
  328.   end;
  329. end;
  330.  
  331. begin
  332. end.
  333.